home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CICA 1993 April
/
CICA MS Windows - April 1993.iso
/
unzipped
/
programr
/
tp
/
orntdll
/
orntdll.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-08-27
|
18KB
|
482 lines
{************************************************************************ }
{ }
{ ORNTDLL.PAS version 1.0 }
{ }
{************************************************************************
Programmer: Jeffrey R. Price EMail: Price.9@OSU.EDU
The Ohio State University Phone: (614) 292-1741
College of Business Fax: (614) 292-1651
Computing Services Center
{************************************************************************
This program and the ORNTDLL.DLL files are freeware. You may use them
freely. If you find the program useful, send me some Email......
{************************************************************************
This Program is used to create a Dynamic Link Library (DLL) that exists
solely to control several printer features.
I wrote it using examples from "Turbo Pascal for Windows 3.0 Programming",
by Tom Swan and from sample code from Borland.
{************************************************************************ }
LIBRARY DLL;
USES Winprocs, WinTypes, WObjects, Strings, Print;
type
TDeviceMode = procedure(HWindow : HWnd;
Module : THandle;
DeviceName : PChar;
OutputName : PChar);
TExtDeviceMode = function(HWindow : HWnd;
HDriver : THandle;
DevModeOutput: PDevMode;
DeviceName : PChar;
OutPutName : PChar;
DevModeInput : PDevMode;
Profile : PChar;
Mode : Word) : Integer;
var
PrinterType, Driver, Port : PChar;
DriverHandle : THandle;
Printer : PDevMode;
ExtDeviceMode : TExtDeviceMode;
DevCaps : TDevCaps;
DeviceMode : TDeviceMode;
PrintDC : HDC;
{************************************************************************
Retrieves comma separated data from a null terminated string. It
returns the first data item and advances the pointer S to the next
data item in the string.
{************************************************************************ }
function GetItem(var S: PChar): PChar;
var
P: PChar;
I: Integer;
begin
I:=0;
while (S[I]<>',') and (S[I]<>#0) do
inc(I);
S[I]:=#0;
GetMem(P, Strlen(S)+1);
StrCopy(P,S);
GetItem:=P;
if S[0]<>#0 then S:=@S[I+1];
end;
{************************************************************************
This local message utility just creates a messagebox. If the value
of HWindow is zero, then the routine does a GetFocus to make sure
that there is a parent.
{************************************************************************ }
procedure LocalMessageBox(HWindow: Hwnd; Text, Caption: PChar; TextType: Word);
begin
if (HWindow = 0)
then MessageBox(GetFocus, Text, Caption, TextType)
else MessageBox(HWindow, Text, Caption, TextType);
end;
{************************************************************************
Retrieves all the device types from the WIN.INI and places this
information into the PStrCollection parameter.}
{************************************************************************ }
procedure GetPrinterTypes(var PrinterTypes: PStrCollection);
var
Buffer, BufferItem : PChar;
Item : PChar;
Count, I : Integer;
begin
New(PrinterTypes, init(5,1));
GetMem(Buffer, 1024);
Count := GetProfileString('devices', nil, ',,', Buffer, 1024);
BufferItem := Buffer;
I := 0;
while I<Count do begin
GetMem(Item, StrLen(BufferItem)+1);
StrCopy(Item, BufferItem);
PrinterTypes^.Insert(Item);
while (BufferItem[i]<>#0) and (I<Count) do
inc(I);
inc(I);
if (BufferItem[I]=#0) then I:=Count;
if (I < Count) then begin
BufferItem := @BufferItem[I];
Count := Count-I;
I := 0;
end;
end;
FreeMem(Buffer, 1024);
end;
{************************************************************************
Given a PrinterType string, this procedure returns the appropriate
driver and port information.}
{************************************************************************ }
procedure GetPrinter(PrinterType: PChar; var Driver, Port: PChar);
var
ProfileInfo, CurrentItem: PChar;
begin
GetMem(ProfileInfo, 80+1);
GetProfileString('devices', PrinterType, ',', ProfileInfo, 80);
CurrentItem := ProfileInfo;
Driver := GetItem(CurrentItem);
Port := GetItem(CurrentItem);
FreeMem(ProfileInfo, 80+1);
end;
{************************************************************************
Retrieves the current printing device information from the WIN.INI
file.
{************************************************************************ }
procedure GetCurrentPrinter(var Driver, PrinterType, Port: PChar);
var
ProfileInfo, CurrentItem: PChar;
begin
GetMem(ProfileInfo, 80+1);
GetProfileString('windows', 'device', ',,', ProfileInfo, 80);
CurrentItem := ProfileInfo;
PrinterType := GetItem(CurrentItem);
Driver := GetItem(CurrentItem);
Port := GetItem(CurrentItem);
FreeMem(ProfileInfo, 80+1);
end;
{************************************************************************
Here is the payoff...We must replace the device= line in the WIN.INI
file with name of the device we want to use
{************************************************************************ }
procedure SetCurrentPrinter(var PrinterName, Driver, Port: PChar);
var
ProfileInfo : PChar;
begin
GetMem(ProfileInfo, 80+1);
StrCopy(ProfileInfo, PrinterName);
StrCat(ProfileInfo, ','); StrCat(ProfileInfo, Driver);
StrCat(ProfileInfo, ','); StrCat(ProfileInfo, Port); StrCat(ProfileInfo, ':');
WriteProfileString('windows', 'device', ProfileInfo);
FreeMem(ProfileInfo, 80+1);
end;
{************************************************************************
We, sometimes, have to bash windows over the skull to let it know that
a change has been made to the printer. This is used to change the
printer options in the WIN.INI file, convincing windows to pay attention!
{************************************************************************ }
procedure SetPrinterOption(var PrinterName, Driver, Port: PChar; OptionName, OptionSetting: PChar);
var
ProfileInfo : PChar;
LocalPort : PChar;
begin
GetMem(ProfileInfo, 80+1);
GetMem(LocalPort, StrLen(Port)+1);
if (StrPos(Port, ':') <> nil)
then StrLCopy(LocalPort, Port, StrLen(Port)-1)
else StrLCopy(LocalPort, Port, StrLen(Port));
StrCopy(ProfileInfo, PrinterName);
StrCat(ProfileInfo, ','); StrCat(ProfileInfo, LocalPort);
WriteProfileString(ProfileInfo, OptionName, OptionSetting);
FreeMem(LocalPort, StrLen(Port)+1);
FreeMem(ProfileInfo, 80+1);
end;
{************************************************************************
Switch to Portrait mode
{************************************************************************ }
Procedure Portrait(HWindow: HWnd); EXPORT;
var
I : Integer;
FullDriverName: PChar;
P : TFarProc;
Size : Integer;
DeviceName,
DriverName,
OutputName : PChar;
DevModeOutput : PDevMode;
BEGIN
GetCurrentPrinter(Driver, PrinterType, Port);
{ Watch out for no installed printer ********************************** }
if (StrLen(Driver) = 0) or
(StrLen(PrinterType) = 0) or
(StrLen(Port) = 0) then begin
LocalMessageBox(HWindow, 'No Printer Installed', 'Error', mb_IconExclamation or mb_Ok);
Exit;
end;
GetMem(FullDriverName, 12+1);
StrLCat(StrCopy(FullDriverName, Driver), '.DRV', 12);
DriverHandle:=LoadLibrary(FullDriverName);
{ Make sure library is loaded ***************************************** }
if (DriverHandle < 32) then begin
LocalMessageBox(HWindow, 'Failed to load driver', 'Error', mb_IconExclamation or mb_Ok);
Exit;
end;
P := GetProcAddress(DriverHandle, 'ExtDeviceMode');
ExtDeviceMode := TExtDeviceMode(P);
Size := ExtDeviceMode(GetFocus, DriverHandle, nil, FullDriverName, Port, nil, nil, 0);
GetMem(DevModeOutput, Size);
{ Read in the Current Settings **************************************** }
ExtDeviceMode(GetFocus, DriverHandle, DevModeOutput, Driver, Port, nil, nil, dm_Copy);
{ Change settings to Landscape **************************************** }
DevModeOutput^.dmOrientation := dmOrient_Portrait;
ExtDeviceMode(GetFocus, DriverHandle, DevModeOutput, FullDriverName, Port, DevModeOutput,nil,dm_Update or dm_Modify);
{ Force change in WIN.INI file **************************************** }
SetPrinterOption(PrinterType, Driver, Port, 'orient', '1');
FreeMem(FullDriverName, 12+1);
FreeMem(DevModeOutput, Size);
FreeLibrary(DriverHandle);
END;
{************************************************************************
Switch to Landscape mode
{************************************************************************ }
Procedure Landscape(HWindow: HWnd); EXPORT;
var
I : Integer;
FullDriverName: PChar;
P : TFarProc;
Size : Integer;
DeviceName,
DriverName,
OutputName : PChar;
DevModeOutput : PDevMode;
BEGIN
GetCurrentPrinter(Driver, PrinterType, Port);
{ Watch out for no installed printer ********************************** }
if (StrLen(Driver) = 0) or
(StrLen(PrinterType) = 0) or
(StrLen(Port) = 0) then begin
LocalMessageBox(HWindow, 'No Printer Installed', 'Error', mb_IconExclamation or mb_Ok);
Exit;
end;
GetMem(FullDriverName, 12+1);
StrLCat(StrCopy(FullDriverName, Driver), '.DRV', 12);
DriverHandle:=LoadLibrary(FullDriverName);
{ Make sure library is loaded ***************************************** }
if (DriverHandle < 32) then begin
LocalMessageBox(HWindow, 'Failed to load driver', 'Error', mb_IconExclamation or mb_Ok);
Exit;
end;
P := GetProcAddress(DriverHandle, 'ExtDeviceMode');
ExtDeviceMode := TExtDeviceMode(P);
Size := ExtDeviceMode(GetFocus, DriverHandle, nil, FullDriverName, Port, nil, nil, 0);
GetMem(DevModeOutput, Size);
{ Read in the Current Settings **************************************** }
ExtDeviceMode(Getfocus, DriverHandle, DevModeOutput, Driver, Port, nil, nil, dm_Copy);
{ Change settings to Landscape **************************************** }
DevModeOutput^.dmOrientation := dmOrient_Landscape;
ExtDeviceMode(GetFocus, DriverHandle, DevModeOutput, FullDriverName, Port, DevModeOutput,nil,dm_Update or dm_Modify);
{ Force change in WIN.INI file **************************************** }
SetPrinterOption(PrinterType, Driver, Port, 'orient', '2');
FreeMem(FullDriverName, 12+1);
FreeMem(DevModeOutput, Size);
FreeLibrary(DriverHandle);
END;
{************************************************************************
Set Printer to the value provided....
{************************************************************************ }
Procedure SetPrinterAs(HWindow: HWnd; PrinterName: String; Notify: Integer); EXPORT;
var
I, Counter : Integer;
Matches : Integer;
PrinterTypes : PStrCollection;
LocalPrinterName : PChar;
FullDriverName : PChar;
ProfileInfo : PChar;
P : TFarProc;
Size : Integer;
DeviceName,
DriverName,
OutputName : PChar;
DevModeOutput : PDevMode;
BEGIN
GetPrinterTypes(PrinterTypes);
{ Are there any installed printers ? ********************************** }
if (PrinterTypes^.Count = 0) then begin
LocalMessageBox(HWindow, 'No Printer Installed', 'Error', mb_IconExclamation or mb_Ok);
Exit;
end;
{ Did user provide a printer name to switch to? *********************** }
if (Length(PrinterName) = 0 or Pos(#0, PrinterName)) then begin
LocalMessageBox(HWindow, 'Printer name not provided', 'Error', mb_IconExclamation or mb_Ok);
Exit;
end;
{ Attempt to match name, then switch to this printer! ***************** }
GetMem(LocalPrinterName, 80+1);
StrPCopy(LocalPrinterName, PrinterName);
i := 0;
Matches := -1;
While ((PrinterTypes^.Count <> i) and
(Matches <> 0)) do begin { While there are some ****** }
Matches := StrComp(LocalPrinterName, PrinterTypes^.At(i));
if (Matches = 0) then begin
GetPrinter(LocalPrinterName, Driver, Port);
{ It's a lot like the others from here *************************** }
GetMem(FullDriverName, 12+1);
StrLCat(StrCopy(FullDriverName, Driver), '.DRV', 12);
DriverHandle:=LoadLibrary(FullDriverName);
{ Make sure library is loaded ************************************ }
if (DriverHandle < 32) then begin
LocalMessageBox(HWindow, 'Failed to load driver', 'Error', mb_IconExclamation or mb_Ok);
Exit;
end;
P := GetProcAddress(DriverHandle, 'ExtDeviceMode');
ExtDeviceMode := TExtDeviceMode(P);
Size := ExtDeviceMode(GetFocus, DriverHandle, nil, FullDriverName, Port, nil, nil, 0);
GetMem(DevModeOutput, Size);
{ Read in the Current Settings **************************************** }
ExtDeviceMode(Getfocus, DriverHandle, DevModeOutput, Driver, Port, nil, nil, dm_Copy);
{ Using same setting, make printer current **************************** }
ExtDeviceMode(GetFocus, DriverHandle, DevModeOutput, FullDriverName, Port,
DevModeOutput, nil, dm_Update or dm_Modify);
SetCurrentPrinter(LocalPrinterName, Driver, Port);
FreeMem(FullDriverName, 12+1);
FreeMem(DevModeOutput, Size);
FreeLibrary(DriverHandle);
end else inc(i);
end; { while }
{ Let user know what (should) have happened if the call wanted us to ******* }
if ((Notify = 1) and (Matches = 0)) then
LocalMessageBox(HWindow, PrinterTypes^.At(i), 'Printer is now', mb_IconExclamation or mb_Ok);
{ If we got through all that and there wasn't a match then notify the user
of the problem *********************************************************** }
if (Matches <> 0) then
LocalMessageBox(HWindow, LocalPrinterName, 'Printer Driver not found', mb_IconStop or mb_Ok);
FreeMem(LocalPrinterName, 80+1);
END;
{************************************************************************
Allow the user to set the number of copies to be generated directly
by the printer. Note that not all printer have the capability to
generate copies automatically. Generally, Laser printers can and
dot matrix printers can't.
{************************************************************************ }
Procedure SetPrinterCopies(HWindow: HWnd; Copies, Notify: Integer); EXPORT;
var
I, ReturnCode : Integer;
FullDriverName: PChar;
P : TFarProc;
Size : Integer;
S : String;
DeviceName, PS,
DriverName,
OutputName : PChar;
DevModeOutput : PDevMode;
DC_Output : PChar;
BEGIN
{ The user must not supply a copies number larger than 999; also the
number must be greater than or = 1 }
if ((Copies > 999) or (Copies <= 0)) then begin
LocalMessageBox(HWindow, 'Number of copies must be between 1 and 999',
'Error', mb_IconExclamation or mb_Ok);
Exit;
end;
GetCurrentPrinter(Driver, PrinterType, Port);
{ Watch out for no installed printer ********************************** }
if (StrLen(Driver) = 0) or
(StrLen(PrinterType) = 0) or
(StrLen(Port) = 0) then begin
LocalMessageBox(HWindow, 'No Printer Installed', 'Error', mb_IconExclamation or mb_Ok);
Exit;
end;
GetMem(FullDriverName, 12+1);
StrLCat(StrCopy(FullDriverName, Driver), '.DRV', 12);
DriverHandle:=LoadLibrary(FullDriverName);
{ Make sure library is loaded ***************************************** }
if (DriverHandle < 32) then begin
LocalMessageBox(HWindow, 'Failed to load driver', 'Error', mb_IconExclamation or mb_Ok);
Exit;
end;
P := GetProcAddress(DriverHandle, 'ExtDeviceMode');
ExtDeviceMode := TExtDeviceMode(P);
Size := ExtDeviceMode(GetFocus, DriverHandle, nil, FullDriverName, Port, nil, nil, 0);
GetMem(DevModeOutput, Size);
{ Read in the Current Settings **************************************** }
ExtDeviceMode(Getfocus, DriverHandle, DevModeOutput, Driver, Port, nil, nil, dm_Copy);
{ Force change in WIN.INI file **************************************** }
GetMem(PS,4); Str(Copies, S); StrPcopy(PS,S);
SetPrinterOption(PrinterType, Driver, Port, 'Copies', PS); FreeMem(PS,4);
{ Change settings to appropriate number of copies ********************* }
DevModeOutput^.dmCopies := Copies;
ExtDeviceMode(GetFocus, DriverHandle, DevModeOutput, FullDriverName, Port, DevModeOutput,nil,dm_Update or dm_Modify);
if (Notify >= 1) then begin
GetMem(PS, 36);
Str(Copies, S); StrLCat(StrPCopy(PS, S), ' :', StrLen(PS) - 1);
LocalMessageBox(HWindow, PS, 'Printer: Copies set to', mb_IconInformation or mb_Ok);
FreeMem(PS, 36);
end;
FreeMem(FullDriverName, 12+1);
FreeMem(DevModeOutput, Size);
FreeLibrary(DriverHandle);
END;
EXPORTS Portrait INDEX 1,
Landscape INDEX 2,
SetPrinterAs INDEX 3,
SetPrinterCopies INDEX 4;
BEGIN
END.